home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / glass / glass.lha / GLASS / libtmc / propt.c < prev    next >
Encoding:
C/C++ Source or Header  |  1990-11-06  |  17.9 KB  |  808 lines
  1. /* 
  2.    Copyright (C) 1990 C van Reewijk, email: dutentb.uucp!reeuwijk
  3.  
  4. This file is part of GLASS.
  5.  
  6. GLASS is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 1, or (at your option)
  9. any later version.
  10.  
  11. GLASS is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GLASS; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. /* file: propt.c
  21.  *
  22.  * Standard handler for optimized printing of datastructures.
  23.  */
  24.  
  25. /* Standard UNIX libraries */
  26. #include <stdio.h>
  27. #include <ctype.h>
  28.  
  29. /* Local definitions */
  30. #include "tmc.h"
  31. #include "config.h"
  32.  
  33. static char fatalerrm[] = "*** fatal error: %s ***\n";
  34. #define FATAL(msg) { fprintf(stderr,fatalerrm,msg); exit(1); }
  35.  
  36. /* the possible error messages */
  37. static char badtag[] = "bad tag: %d";
  38. static char badtagspc[30]; /* to store output of format string above */
  39. static char outofmemory[] = "out of memory";
  40.  
  41. #define FATALTAG(tag) {(void) sprintf(badtagspc,badtag,tag); FATAL(badtagspc);}
  42.  
  43. /* statistics */
  44.  
  45. /* width of a tab as generated by '\t' */
  46. #define TABWIDTH 8
  47.  
  48. #ifndef TRUE
  49. #define TRUE 1
  50. #endif
  51. #ifndef FALSE
  52. #define FALSE 0
  53. #endif
  54.  
  55. typedef short bool;
  56.  
  57. static char *linebuf = (char *) 0;
  58.  
  59. /* datastructures */
  60. typedef struct str_Sstack *Sstack;
  61. typedef struct str_sunit *sunit;
  62. typedef struct str_SuWord *SuWord;
  63. typedef struct str_SuCons *SuCons;
  64. typedef struct str_SuList *SuList;
  65. typedef struct str_SuTuple *SuTuple;
  66.  
  67. #define SstackNIL (Sstack)0
  68. #define sunitNIL (sunit)0
  69. #define SuWordNIL (SuWord)0
  70. #define SuConsNIL (SuCons)0
  71. #define SuListNIL (SuList)0
  72.  
  73. typedef struct str_Sstack {
  74.     Sstack next;
  75.     sunit ulist;
  76. };
  77.  
  78. typedef struct str_sunit {
  79.     sunit next;
  80.     int tag;
  81. };
  82.  
  83. /* possible tags for sunit: */
  84. #define TAGSuWord 1
  85. #define TAGSuCons 2
  86. #define TAGSuList 3
  87. #define TAGSuTuple 4
  88.  
  89. typedef struct str_SuWord {
  90.     sunit next;
  91.     int tag;
  92.     string word;
  93. };
  94.  
  95. typedef struct str_SuCons {
  96.     sunit next;
  97.     int tag;
  98.     sunit ulist;
  99. };
  100.  
  101. typedef struct str_SuList {
  102.     sunit next;
  103.     int tag;
  104.     sunit ulist;
  105. };
  106.  
  107. typedef struct str_SuTuple {
  108.     sunit next;
  109.     int tag;
  110.     sunit ulist;
  111. };
  112.  
  113. /* local variables of printopt. */
  114. static FILE *so_file;        /* output file */
  115. static int so_istep;        /* indent step */
  116. static int so_width;        /* with of output */
  117. static int braclev;        /* current bracket level */
  118. static sunit curlist;        /* current list of units */
  119. static Sstack stack;        /* stack of open constr. & lists */
  120.  
  121. /* prototypes are concentrated in one place to make it easy
  122.  * for the preprocessor.
  123.  */
  124. #if defined( __STDC__ ) && __STDC__>0
  125. /* allocate routines */
  126. static Sstack newSstack( sunit u );
  127. static sunit newSuWord( string s );
  128. static sunit newSuCons( sunit u );
  129. static sunit newSuList( sunit l );
  130. static sunit newSuTuple( sunit l );
  131. static void rfresunit( sunit e );
  132.  
  133. /* recursive free routines */
  134. static void rfreSuWord( SuWord e );
  135. static void rfreSuCons( SuCons e );
  136. static void rfreSuList( SuList l );
  137. static void rfreSuTuple( SuTuple t );
  138. static void rfresunit_list( sunit l );
  139.  
  140. static sunit appsunitlist( sunit a, sunit b );
  141.  
  142. static int lenlist( sunit l );
  143. static void doindent( int n );
  144.  
  145. static void pushlev( void );
  146. static void poplev( void );
  147. static int lencons( sunit l );
  148. static int lentuple( sunit l );
  149. static void vertprintcons( SuCons c, int lev );
  150. static void vertprinttuple( SuTuple t, int lev );
  151. static void vertprintlist( SuList lst, int lev );
  152. static void vertprintsunit( sunit e, int lev );
  153. static char *horprintcons( sunit l );
  154. static char *horprinttuple( sunit l );
  155. static char *horprintlist( sunit l );
  156. #else
  157. /* allocate routines */
  158. static Sstack newSstack();
  159. static sunit newSuWord();
  160. static sunit newSuCons();
  161. static sunit newSuList();
  162. static sunit newSuTuple();
  163.  
  164. /* recursive free routines */
  165. static void rfreSuWord();
  166. static void rfreSuCons();
  167. static void rfreSuList();
  168. static void rfreSuTuple();
  169. static void rfresunit_list();
  170. #endif
  171.  
  172. /*******************************************************************\
  173. *    Allocation routines                                            *
  174. \*******************************************************************/
  175.  
  176. static Sstack newSstack( par_ulist )
  177.  sunit par_ulist;
  178. {
  179.     Sstack new;
  180.  
  181.     new = (Sstack) malloc( sizeof(*new));
  182.     if( (char *)new == (char *)0 ) FATAL( outofmemory );
  183.     new->next = SstackNIL;
  184.     new->ulist = par_ulist;
  185.     return( (Sstack) new );
  186. }
  187.  
  188. static sunit newSuWord( par_word )
  189.  string par_word;
  190. {
  191.     SuWord new;
  192.  
  193.     new = (SuWord) malloc( sizeof(*new));
  194.     if( (char *)new == (char *)0 ) FATAL( outofmemory );
  195.     new->next = sunitNIL;
  196.     new->tag = TAGSuWord;
  197.     new->word = par_word;
  198.     return( (sunit) new );
  199. }
  200.  
  201. static sunit newSuCons( par_ulist )
  202.  sunit par_ulist;
  203. {
  204.     SuCons new;
  205.  
  206.     new = (SuCons) malloc( sizeof(*new));
  207.     if( (char *)new == (char *)0 ) FATAL( outofmemory );
  208.     new->next = sunitNIL;
  209.     new->tag = TAGSuCons;
  210.     new->ulist = par_ulist;
  211.     return( (sunit) new );
  212. }
  213.  
  214. static sunit newSuList( par_ulist )
  215.  sunit par_ulist;
  216. {
  217.     SuList new;
  218.  
  219.     new = (SuList) malloc( sizeof(*new));
  220.     if( (char *)new == (char *)0 ) FATAL( outofmemory );
  221.     new->next = sunitNIL;
  222.     new->tag = TAGSuList;
  223.     new->ulist = par_ulist;
  224.     return( (sunit) new );
  225. }
  226.  
  227. static sunit newSuTuple( par_ulist )
  228.  sunit par_ulist;
  229. {
  230.     SuTuple new;
  231.  
  232.     new = (SuTuple) malloc( sizeof(*new));
  233.     if( (char *)new == (char *)0 ) FATAL( outofmemory );
  234.     new->next = sunitNIL;
  235.     new->tag = TAGSuTuple;
  236.     new->ulist = par_ulist;
  237.     return( (sunit) new );
  238. }
  239.  
  240. /*******************************************************************\
  241. *    Freeing routines                                               *
  242. \*******************************************************************/
  243.  
  244. #define freSstack(e) TMFREE( e );
  245. #define freSuWord(e) TMFREE( e );
  246. #define freSuCons(e) TMFREE( e );
  247. #define freSuList(e) TMFREE( e );
  248. #define freSuTuple(e) TMFREE( e );
  249.  
  250. /*******************************************************************\
  251. *    Recursive freeing routines                                     *
  252. \*******************************************************************/
  253.  
  254. /* free an element of type sunit, constructor SuWord, and all elements
  255.    in the constructor.
  256.  */
  257. static void rfreSuWord( e )
  258.  SuWord e;
  259. {
  260.     fre_string( e->word );
  261.     freSuWord( e );
  262. }
  263.  
  264. /* free an element of type sunit, constructor SuCons, and all elements in the constructor
  265.  */
  266. static void rfreSuCons( e )
  267.  SuCons e;
  268. {
  269.     rfresunit_list( e->ulist );
  270.     freSuCons( e );
  271. }
  272.  
  273. /* free an element of type sunit, constructor SuList, and all elements in the
  274.    constructor
  275.  */
  276. static void rfreSuList( e )
  277.  SuList e;
  278. {
  279.     rfresunit_list( e->ulist );
  280.     freSuList( e );
  281. }
  282.  
  283. /* free an element of type sunit, constructor SuTuple, and all elements in the
  284.    constructor
  285.  */
  286. static void rfreSuTuple( e )
  287.  SuTuple e;
  288. {
  289.     rfresunit_list( e->ulist );
  290.     freSuTuple( e );
  291. }
  292.  
  293.  
  294. /* recursively free an element of type sunit
  295.    and all elements in it.
  296.  */
  297. static void rfresunit( e )
  298.  sunit e;
  299. {
  300.     switch( e->tag ){
  301.         case TAGSuWord:
  302.         rfreSuWord( (SuWord) e );
  303.         break;
  304.  
  305.         case TAGSuCons:
  306.         rfreSuCons( (SuCons) e );
  307.         break;
  308.  
  309.         case TAGSuList:
  310.         rfreSuList( (SuList) e );
  311.         break;
  312.  
  313.         case TAGSuTuple:
  314.         rfreSuTuple( (SuTuple) e );
  315.         break;
  316.  
  317.         default:
  318.         FATALTAG( e->tag );
  319.     }
  320. }
  321.  
  322. /* recursively free a list of elements of type sunit */
  323. static void rfresunit_list( e )
  324.  sunit e;
  325. {
  326.     sunit n;
  327.  
  328.     while( e!=sunitNIL ){
  329.     n = e->next;
  330.     rfresunit( e );
  331.     e = n;
  332.     }
  333. }
  334.  
  335. /*******************************************************************\
  336. *    Append routines                                                *
  337. \*******************************************************************/
  338.  
  339. /* append list of sunit 'b' after list of sunit 'a' */
  340. static sunit appsunitlist( a, b )
  341.  sunit a;
  342.  sunit b;
  343. {
  344.    sunit tl;
  345.  
  346.    if( a == sunitNIL ) return( b );
  347.    tl = a;
  348.    while( tl->next != sunitNIL ) tl = tl->next;
  349.    tl->next = b;
  350.    return( a );
  351. }
  352.  
  353. static void doindent( n )
  354.  int n;
  355. {
  356.     while( n >= TABWIDTH ){
  357.     fputc( '\t', so_file );
  358.     n -= TABWIDTH;
  359.     }
  360.     while( n > 0 ){
  361.     fputc( ' ', so_file );
  362.     n--;
  363.     }
  364. }
  365.  
  366. /******************************************************
  367.  *            DETERMINATION OF STRING LENGTH          *
  368.  ******************************************************/
  369.  
  370. /* Determine the length of a constructor string when printed
  371.    on one line.
  372.  
  373.    This is done as follows:
  374.    - the length of a list containing sub-lists is 0.
  375.    - the length of a constructor without members is 2 (for the brackets).
  376.    - For a word list of length 1 the length is the length of the word.
  377.    - Otherwise the opening and closing brackets cause an overhead
  378.      of 2 spaces.
  379.    - Each word adds its string length.
  380.    - All words are separated by 1 space.
  381.  
  382.    When counting a space for each word in the list, the netto overhead
  383.    of the brackets is 1 spaces.
  384.  */
  385. static int lencons( l )
  386.  sunit l;
  387. {
  388.     int len = 1;    /* overhead */
  389.  
  390.     if( l == sunitNIL ) return( 2 );
  391.     if( l->next == sunitNIL && l->tag == TAGSuWord )
  392.     return( (int) strlen( ((SuWord)l)->word ) );
  393.     while( l != sunitNIL ){
  394.     if( l->tag != TAGSuWord ) return( 0 );
  395.     len += 1 + (int) strlen( ((SuWord)l)->word );
  396.     l = l->next;
  397.     }
  398.     return( len );
  399. }
  400.  
  401. /* Determine the length of a list string when printed
  402.    on one line.
  403.  
  404.    This is done as follows:
  405.    - The length of a list containing sub-lists is 0.
  406.    - For a word list of length 0 the length is 2 (since "[]" is printed).
  407.    - Otherwise the opening and closing brackets cause an overhead
  408.      of 2 spaces.
  409.    - Each word adds its string length.
  410.    - All words are separated by 1 comma and 1 space.
  411.  
  412.    When counting a space and comma for each word in the list,
  413.    the netto overhead of the brackets is 0 spaces.
  414.  */
  415. static int lenlist( l )
  416.  sunit l;
  417. {
  418.     int len = 0;    /* overhead */
  419.  
  420.     if( l == sunitNIL ) return( 2 );
  421.     while( l != sunitNIL ){
  422.     if( l->tag != TAGSuWord ) return( 0 );
  423.     len += 2 + (int) strlen( ((SuWord)l)->word );
  424.     l = l->next;
  425.     }
  426.     return( len );
  427. }
  428.  
  429. /* Determine the length of a tuple string when printed
  430.    on one line.
  431.  
  432.    This is done as follows:
  433.    - The length of a tuple containing sub-tuples is 0.
  434.    - For a word tuple of length 0 the length is 2 (since "()" is printed).
  435.    - Otherwise the opening and closing brackets cause an overhead
  436.      of 2 spaces.
  437.    - Each word adds its string length.
  438.    - All words are separated by 1 comma and 1 space.
  439.  
  440.    When counting a space and comma for each word in the list,
  441.    the netto overhead of the brackets is 0 spaces.
  442.  */
  443. static int lentuple( l )
  444.  sunit l;
  445. {
  446.     int len = 0;    /* overhead */
  447.  
  448.     if( l == sunitNIL ) return( 2 );
  449.     while( l != sunitNIL ){
  450.     if( l->tag != TAGSuWord ) return( 0 );
  451.     len += 2 + (int) strlen( ((SuWord)l)->word );
  452.     l = l->next;
  453.     }
  454.     return( len );
  455. }
  456.  
  457. /******************************************************
  458.  *            HORIZONTAL PRINTING ROUTINE             *
  459.  ******************************************************/
  460.  
  461. static void vertprintsunit();
  462.  
  463. /* Print constructor 'c' in vertical mode. */
  464. static void vertprintcons( c, lev )
  465.  SuCons c;
  466.  int lev;
  467. {
  468.     sunit l;
  469.  
  470.     l = c->ulist;
  471.     if( l != sunitNIL && l->next == sunitNIL ){
  472.     vertprintsunit( l, lev );
  473.     return;
  474.     }
  475.     doindent( so_istep * lev );
  476.     fputs( "(\n", so_file );
  477.     while( l != sunitNIL ){
  478.     vertprintsunit( l, (lev+1) );
  479.     fputc( '\n', so_file );
  480.     l = l->next;
  481.     }
  482.     doindent( so_istep * lev );
  483.     fputc( ')', so_file );
  484.     return;
  485. }
  486.  
  487. /* Print list 'lst' in vertical mode. */
  488. static void vertprintlist( lst, lev )
  489.  SuList lst;
  490.  int lev;
  491. {
  492.     sunit l;
  493.  
  494.     l = lst->ulist;
  495.     if( l == sunitNIL ){
  496.     doindent( so_istep * lev );
  497.     fputs( "[]", so_file );
  498.     return;
  499.     }
  500.     doindent( so_istep * lev );
  501.     fputs( "[\n", so_file );
  502.     while( l != sunitNIL ){
  503.     vertprintsunit( l, (lev+1) );
  504.     l = l->next;
  505.     if( l != sunitNIL ) fputc( ',', so_file );
  506.     fputc( '\n', so_file );
  507.     }
  508.     doindent( so_istep * lev );
  509.     fputc( ']', so_file );
  510.     return;
  511. }
  512.  
  513. /* Print tuple 'tpl' in vertical mode. */
  514. static void vertprinttuple( lst, lev )
  515.  SuTuple lst;
  516.  int lev;
  517. {
  518.     sunit l;
  519.  
  520.     l = lst->ulist;
  521.     if( l == sunitNIL ){
  522.     doindent( so_istep * lev );
  523.     fputs( "()", so_file );
  524.     return;
  525.     }
  526.     doindent( so_istep * lev );
  527.     fputs( "(\n", so_file );
  528.     while( l != sunitNIL ){
  529.     vertprintsunit( l, (lev+1) );
  530.     l = l->next;
  531.     if( l != sunitNIL ) fputc( ',', so_file );
  532.     fputc( '\n', so_file );
  533.     }
  534.     doindent( so_istep * lev );
  535.     fputc( ')', so_file );
  536.     return;
  537. }
  538.  
  539. /* Given a unit 'l' and a indent level 'lev', print given
  540.    unit to 'so_file'. When neccary delegate printing to
  541.    specialized routines 'vertprint{list,tuple,cons}()'.
  542.  
  543.    NOTE: no return is printed after the last line, so
  544.    that a comma can be appended when necessary.
  545.  */
  546. static void vertprintsunit( l, lev )
  547.  sunit l;
  548.  int lev;
  549. {
  550.     switch( l->tag ){
  551.     case TAGSuWord:
  552.         doindent( so_istep * lev );
  553.         fputs( ((SuWord)l)->word, so_file );
  554.         break;
  555.  
  556.     case TAGSuCons:
  557.         vertprintcons( (SuCons) l, lev );
  558.         break;
  559.  
  560.     case TAGSuList:
  561.         vertprintlist( (SuList) l, lev );
  562.         break;
  563.  
  564.     case TAGSuTuple:
  565.         vertprinttuple( (SuTuple) l, lev );
  566.         break;
  567.     }
  568. }
  569.  
  570. /* Print list consisting of sunits in 'l' in
  571.    horizontal mode, and return a new string for it.
  572.  */
  573. static char *horprintlist( l )
  574.  sunit l;
  575. {
  576.     char *bufp;
  577.     char *v;
  578.  
  579.     if( l == sunitNIL ) return( new_string( "[]" ) );
  580.     bufp = linebuf;
  581.     *bufp++ = '[';
  582.     while( l != sunitNIL ){
  583.     v = ((SuWord)l)->word;
  584.     while( *v ) *bufp++ = *v++;
  585.     l = l->next;
  586.     if( l != sunitNIL ){
  587.         *bufp++ = ',';
  588.         *bufp++ = ' ';
  589.     }
  590.     }
  591.     *bufp++ = ']';
  592.     *bufp = '\0';
  593.     return( new_string( linebuf ) );
  594. }
  595.  
  596. /* Print tuple consisting of sunits in 'l' in
  597.    horizontal mode, and return a new string for it.
  598.  */
  599. static char *horprinttuple( l )
  600.  sunit l;
  601. {
  602.     char *bufp;
  603.     char *v;
  604.  
  605.     if( l == sunitNIL ) return( new_string( "()" ) );
  606.     bufp = linebuf;
  607.     *bufp++ = '(';
  608.     while( l != sunitNIL ){
  609.     v = ((SuWord)l)->word;
  610.     while( *v ) *bufp++ = *v++;
  611.     l = l->next;
  612.     if( l != sunitNIL ){
  613.         *bufp++ = ',';
  614.         *bufp++ = ' ';
  615.     }
  616.     }
  617.     *bufp++ = ')';
  618.     *bufp = '\0';
  619.     return( new_string( linebuf ) );
  620. }
  621.  
  622. /* Print constructor consisting of sunits in 'l' in
  623.    horizontal mode, and return a new string for it.
  624.  */
  625. static char *horprintcons( l )
  626.  sunit l;
  627. {
  628.     char *bufp;
  629.     char *v;
  630.  
  631.     if( l == sunitNIL ) return( new_string( "()" ) );
  632.     if( l->next == sunitNIL ) return( new_string( ((SuWord)l)->word ) );
  633.     bufp = linebuf;
  634.     *bufp++ = '(';
  635.     while( l != sunitNIL ){
  636.     v = ((SuWord)l)->word;
  637.     while( *v ) *bufp++ = *v++;
  638.     l = l->next;
  639.     if( l != sunitNIL ) *bufp++ = ' ';
  640.     }
  641.     *bufp++ = ')';
  642.     *bufp = '\0';
  643.     return( new_string( linebuf ) );
  644. }
  645.  
  646. /******************************************************
  647.  *            STACK MANAGEMENT ROUTINES               *
  648.  ******************************************************/
  649.  
  650. /* push current level on stack */
  651. static void pushlev()
  652. {
  653.     register Sstack new;
  654.  
  655.     new = newSstack( curlist );
  656.     new->next = stack;
  657.     stack = new;
  658. }
  659.  
  660. static void poplev()
  661. {
  662.     Sstack e;
  663.  
  664.     if( stack == SstackNIL ) FATAL( "pop of empty printstack" );
  665.     e = (Sstack) stack;
  666.     curlist = e->ulist;
  667.     stack = e->next;
  668.     freSstack( (Sstack) e );
  669. }
  670.  
  671. /******************************************************
  672.  *            TOP LEVEL ROUTINES                      *
  673.  ******************************************************/
  674.  
  675. /* start a new constructor */
  676. void opencons()
  677. {
  678.     pushlev();
  679.     braclev++;
  680.     curlist = sunitNIL;
  681. }
  682.  
  683. /* terminate current constructor */
  684. void closecons()
  685. {
  686.     register sunit new;
  687.     register int len;
  688.  
  689.     braclev--;
  690.     len = lencons( curlist );
  691.     if( len != 0 && (len + (braclev * so_istep)) < so_width ){
  692.     new = newSuWord( horprintcons( curlist ) );
  693.     rfresunit_list( curlist );
  694.     }
  695.     else {
  696.     new = newSuCons( curlist );
  697.     }
  698.     poplev();
  699.     if( braclev<1 ){
  700.     vertprintsunit( new, 0 );
  701.     fputc( '\n', so_file );
  702.     rfresunit( new );
  703.     return;
  704.     }
  705.     curlist = appsunitlist( curlist, new );
  706. }
  707.  
  708. /* start a new list */
  709. void openlist()
  710. {
  711.     pushlev();
  712.     braclev++;
  713.     curlist = sunitNIL;
  714. }
  715.  
  716. /* terminate current list */
  717. void closelist()
  718. {
  719.     register sunit new;
  720.     register int len;
  721.  
  722.     braclev--;
  723.     len = lenlist( curlist );
  724.     if( len != 0 && (len + (braclev * so_istep)) < so_width ){
  725.     new = newSuWord( horprintlist( curlist ) );
  726.     rfresunit_list( curlist );
  727.     }
  728.     else {
  729.     new = newSuList( curlist );
  730.     }
  731.     poplev();
  732.     if( braclev<1 ){
  733.     vertprintsunit( new, 0 );
  734.     fputc( '\n', so_file );
  735.     rfresunit( new );
  736.     return;
  737.     }
  738.     curlist = appsunitlist( curlist, new );
  739. }
  740.  
  741. /* start a new tuple */
  742. void opentuple()
  743. {
  744.     pushlev();
  745.     braclev++;
  746.     curlist = sunitNIL;
  747. }
  748.  
  749. /* terminate current tuple */
  750. void closetuple()
  751. {
  752.     register sunit new;
  753.     register int len;
  754.  
  755.     braclev--;
  756.     len = lentuple( curlist );
  757.     if( len != 0 && (len + (braclev * so_istep)) < so_width ){
  758.     new = newSuWord( horprinttuple( curlist ) );
  759.     rfresunit_list( curlist );
  760.     }
  761.     else {
  762.     new = newSuTuple( curlist );
  763.     }
  764.     poplev();
  765.     if( braclev<1 ){
  766.     vertprintsunit( new, 0 );
  767.     fputc( '\n', so_file );
  768.     rfresunit( new );
  769.     return;
  770.     }
  771.     curlist = appsunitlist( curlist, new );
  772. }
  773.  
  774. /* add word 'w' to the current unit list, or print it
  775.    directly if no brackets are opened.
  776.  */
  777. void printword( w )
  778.  char *w;
  779. {
  780.     register sunit new;
  781.  
  782.     if( braclev<1 ){
  783.     fputs( w, so_file );
  784.     fputc( '\n', so_file );
  785.     return;
  786.     }
  787.     new = newSuWord( new_string( w ) );
  788.     curlist = appsunitlist( curlist, new );
  789. }
  790.  
  791. void setprint( f, istep, width )
  792.  FILE *f;
  793.  int istep;
  794.  int width;
  795. {
  796.     so_file = f;
  797.     so_istep = istep;
  798.     so_width = width;
  799.     braclev = 0;
  800.     stack = SstackNIL;
  801.     curlist = sunitNIL;
  802.     if( linebuf != (char *)0 ){
  803.     TMFREE( linebuf );
  804.     }
  805.     linebuf = malloc( (unsigned) width+10 );
  806.     if( linebuf == (char *)0 ) FATAL( outofmemory );
  807. }
  808.